home *** CD-ROM | disk | FTP | other *** search
/ Atari Forever 4 / Atari Forever 4.zip / Atari Forever 4.iso / SERIE_S / S_904 / MINE / MINE.LST < prev    next >
File List  |  1998-03-14  |  8KB  |  401 lines
  1. DEFMOUSE 0
  2. DEFTEXT ,,,13
  3. DIM feld|(17,17)
  4. DIM t%(10),name$(10)
  5. DIM m&(16)
  6. '
  7. lade_high
  8. '
  9. '
  10. adr%=V:m&(0)
  11. ww&=x_len|*16
  12. wh&=y_len|*16+33
  13. CLIP  OFFSET wx&,wy&
  14. ~WIND_CALC(0,&X1011,wx&,wy&,ww&,wh&,wx&,wy&,ww&,wh&)
  15. handle&=WIND_CREATE(&X1011,wx&,wy&,ww&,wh&)
  16. '
  17. titel$=" Minenfeld "+CHR$(0)
  18. ~WIND_SET(handle&,2,CARD(SWAP(V:titel$)),CARD(V:titel$),0,0)
  19. '
  20. ~WIND_OPEN(handle&,wx&,wy&,ww&,wh&)
  21. '
  22. erstelle
  23. REPEAT
  24.   rate
  25.   ~@taste
  26.   IF gewonnen!=FALSE
  27.     t%=99999
  28.   ENDIF
  29.   highscore(t%)
  30.   IF wclose!=FALSE
  31.     ende!=0
  32.     gewonnen!=0
  33.     erstelle
  34.     ~WIND_GET(handle&,4,wx&,wy&,ww&,wh&)
  35.     DEFFILL 0,0,0
  36.     PBOX 0,0,ww&-1,wh&-1
  37.     aufbau
  38.   ENDIF
  39. UNTIL wclose!
  40. '
  41. ~WIND_CLOSE(handle&)
  42. ~WIND_DELETE(handle&)
  43. '
  44. speicher_high
  45. '
  46. PROCEDURE lade_high
  47.   LOCAL n$
  48.   wx&=97
  49.   wy&=100
  50.   n$=DIR$(0)+"\MINEHIGH.SCR"
  51.   IF EXIST(n$)
  52.     OPEN "I",#1,n$
  53.     INPUT #1,x_len|
  54.     INPUT #1,y_len|
  55.     INPUT #1,minen|
  56.     FOR i|=1 TO 10
  57.       INPUT #1,t%(i|)
  58.       INPUT #1,name$(i|)
  59.     NEXT i|
  60.     CLOSE #1
  61.   ELSE
  62.     x_len|=16
  63.     y_len|=16
  64.     minen|=40
  65.     ARRAYFILL t%(),99999
  66.     FOR i|=1 TO 10
  67.       LET name$(i|)="niemand"
  68.     NEXT i|
  69.   ENDIF
  70. RETURN
  71. PROCEDURE speicher_high
  72.   OPEN "o",#1,DIR$(0)+"\MINEHIGH.SCR"
  73.   PRINT #1,x_len|
  74.   PRINT #1,y_len|
  75.   PRINT #1,minen|
  76.   FOR i|=1 TO 10
  77.     PRINT #1,t%(i|);",";name$(i|)
  78.   NEXT i|
  79.   CLOSE #1
  80. RETURN
  81. > PROCEDURE erstelle
  82.   ' Erstellt ein Minenfeld in feld|() mit minen| Minen
  83.   LOCAL i|,x|,y|
  84.   ARRAYFILL feld|(),0
  85.   REPEAT
  86.     x|=RANDOM(x_len|)+1
  87.     y|=RANDOM(y_len|)+1
  88.     IF feld|(x|,y|)=0
  89.       feld|(x|,y|)=1
  90.       INC i|
  91.     ENDIF
  92.   UNTIL i|=minen|
  93.   verdeckt&=x_len|*y_len|
  94.   marken&=minen|
  95.   t%=-1
  96.   h%=2^30
  97. RETURN
  98. '
  99. > PROCEDURE aufbau
  100.   LOCAL x|,y|
  101.   BOUNDARY 0
  102.   FOR x|=1 TO x_len|
  103.     FOR y|=1 TO y_len|
  104.       punkt(x|,y|)
  105.     NEXT y|
  106.   NEXT x|
  107.   werte
  108. RETURN
  109. > PROCEDURE werte
  110.   TEXT 2,y_len|*16+16-3,"Marken: "+STR$(marken&)+" "
  111.   IF ende!=0
  112.     IF t%>0
  113.       TEXT 2+12*8,y_len|*16+16-3,"Zeit: "+STR$(INT((TIMER-t%)/200))+"    "
  114.     ENDIF
  115.   ELSE
  116.     TEXT 2+12*8,y_len|*16+16-3,"Zeit: "+STR$(INT(t%)/10)+"    "
  117.     IF minen|=verdeckt&
  118.       TEXT 2,y_len|*16+32-3,"GEWONNEN"
  119.     ELSE
  120.       TEXT 2,y_len|*16+32-3,"Nicht geschafft"
  121.     ENDIF
  122.     TEXT 2+x_len|*16-10*8,y_len|*16+32-3,"- Taste -"
  123.   ENDIF
  124. RETURN
  125. > PROCEDURE punkt(x|,y|)
  126.   LOCAL s|
  127.   ~WIND_GET(handle&,4,wx&,wy&,ww&,wh&)
  128.   CLIP  OFFSET wx&,wy&
  129.   '
  130.   SELECT feld|(x|,y|)
  131.   CASE 0,1            !Nicht aufgedeckt
  132.     3d_box(x|,y|)
  133.     IF feld|(x|,y|)=1 AND ende!
  134.       text(x|,y|,ASC("M"))
  135.     ENDIF
  136.   CASE 2            !Frei
  137.     box(x|,y|)
  138.     s|=@um(x|,y|)
  139.     IF s|
  140.       text(x|,y|,ASC(STR$(s|)))
  141.     ENDIF
  142.   CASE 11,10               !Markiert
  143.     IF feld|(x|,y|)=10 AND ende!
  144.       box(x|,y|)
  145.     ELSE
  146.       3d_box(x|,y|)
  147.     ENDIF
  148.     kreuz(x|,y|)
  149.   ENDSELECT
  150. RETURN
  151. > PROCEDURE 3d_box(x|,y|)
  152.   DEFFILL 1,2,4
  153.   PBOX (x|-1)*16+2,(y|-1)*16+2,x|*16-2,y|*16-2
  154.   LINE x|*16-1,(y|-1)*16+1,x|*16-1,y|*16-1
  155.   LINE (x|-1)*16+1,y|*16-1,x|*16-1,y|*16-1
  156. RETURN
  157. > PROCEDURE box(x|,y|)
  158.   DEFFILL 1,2,1
  159.   PBOX (x|-1)*16+1,(y|-1)*16+1,x|*16-1,y|*16-1
  160. RETURN
  161. > PROCEDURE kreuz(x|,y|)
  162.   DEFLINE ,3
  163.   LINE (x|-1)*16+2,(y|-1)*16+2,x|*16-2,y|*16-2
  164.   LINE x|*16-2,(y|-1)*16+2,(x|-1)*16+2,y|*16-2
  165.   DEFLINE ,1
  166. RETURN
  167. > PROCEDURE text(x|,y|,char|)
  168.   GRAPHMODE 2
  169.   TEXT (x|-1)*16+16/4,y|*16-2,CHR$(char|)
  170.   GRAPHMODE 1
  171. RETURN
  172. > FUNCTION um(x|,y|)
  173. LOCAL s|
  174. s|=@mine(x|-1,y|-1)+@mine(x|,y|-1)+@mine(x|+1,y|-1)
  175. s|=s|+@mine(x|-1,y|)+@mine(x|+1,y|)
  176. s|=s|+@mine(x|-1,y|+1)+@mine(x|,y|+1)+@mine(x|+1,y|+1)
  177. RETURN s|
  178. ENDFUNC
  179. > FUNCTION mine(x|,y|)
  180. IF feld|(x|,y|)=1 OR feld|(x|,y|)=11
  181. RETURN 1
  182. ELSE
  183. RETURN 0
  184. ENDIF
  185. ENDFUNC
  186. '
  187. > PROCEDURE rate
  188. LOCAL x|,y|,mt&
  189. REPEAT
  190. mt&=@waehle(x|,y|)
  191. IF x|>0 AND y|>0 AND wclose!=FALSE
  192.   IF mt&=1                   !Freimachen
  193.     IF t%=-1
  194.       t%=TIMER
  195.       h%=0
  196.     ENDIF
  197.     IF feld|(x|,y|)=0          !freies Feld
  198.       free(x|,y|)
  199.       gewonnen!=(verdeckt&=minen|)
  200.       ende!=gewonnen!
  201.     ELSE IF feld|(x|,y|)=1     !Fehler -> Ende
  202.       ende!=TRUE
  203.     ENDIF
  204.     IF ende!
  205.       t%=(TIMER-t%)/20
  206.     ENDIF
  207.   ELSE !IF mt&=2
  208.     IF feld|(x|,y|)<=1         !Markieren
  209.       ADD feld|(x|,y|),10
  210.       DEC marken&
  211.     ELSE IF feld|(x|,y|)=>10    !Marke Löschen
  212.       SUB feld|(x|,y|),10
  213.       INC marken&
  214.     ENDIF
  215.     punkt(x|,y|)
  216.   ENDIF
  217. ENDIF
  218. UNTIL ende!
  219. IF wclose!=FALSE
  220. werte
  221. FOR x|=1 TO x_len|
  222.   FOR y|=1 TO y_len|
  223.     IF feld|(x|,y|)=1 AND gewonnen!
  224.       marken&=0
  225.       feld|(x|,y|)=11
  226.       punkt(x|,y|)
  227.       werte
  228.     ENDIF
  229.     IF feld|(x|,y|)=10 OR feld|(x|,y|)=1
  230.       punkt(x|,y|)
  231.     ENDIF
  232.   NEXT y|
  233. NEXT x|
  234. '
  235. ENDIF
  236. RETURN
  237. FUNCTION waehle(VAR x|,y|)
  238. LOCAL mx&,my&,mt&,d&,e&
  239. ' auf Maus und Fenster warten
  240. ~EVNT_BUTTON(1,3,0)           !keine linke Taste
  241. REPEAT
  242. e&=EVNT_MULTI(&X110000,1,3,1,0,0,0,0,0,0,0,0,0,0,adr%,10,mx&,my&,mt&,d&,d&,d&)
  243. mt&=GINTOUT(3)
  244. '              f       c m s 1 2 3 4 5 1 2 3 4 5 a    c mx  my  mk  k  t  anz
  245. IF e& AND &X10000
  246.   fensterverw
  247. ELSE IF e& AND &X100000
  248.   IF h%<TIMER-t%
  249.     ~WIND_GET(handle&,10,wx&,d&,d&,d&)
  250.     IF wx&=handle&
  251.       ADD h%,200
  252.       werte
  253.     ENDIF
  254.   ENDIF
  255. ENDIF
  256. UNTIL (mt&>0) OR ende!
  257. ~WIND_GET(handle&,4,wx&,wy&,ww&,wh&)
  258. '
  259. x|=MAX((INT(mx&-wx&)/16)+1,0)
  260. IF x|>x_len|
  261. x|=0
  262. ENDIF
  263. '
  264. y|=MAX(INT((my&-wy&)/16)+1,0)
  265. IF y|>y_len|
  266. y|=0
  267. ENDIF
  268. RETURN MIN(mt&,2)
  269. ENDFUNC
  270. > PROCEDURE free(x|,y|)
  271. ' Ein Feld ohne Mine wurde als solches erkannt. Falls auf keinem
  272. ' Nachbarfeld eine Mine liegt, werden alle eindeutig freien Felder
  273. ' auch aufgedeckt.
  274. '
  275. LOCAL i|,j|
  276. feld|(x|,y|)=2
  277. punkt(x|,y|)
  278. DEC verdeckt&
  279. IF @um(x|,y|)=0
  280. FOR i|=MAX(x|-1,1) TO MIN(x|+1,x_len|)
  281.   FOR j|=MAX(y|-1,1) TO MIN(y|+1,y_len|)
  282.     IF feld|(i|,j|)=0
  283.       free(i|,j|)
  284.     ENDIF
  285.   NEXT j|
  286. NEXT i|
  287. ENDIF
  288. RETURN
  289. '
  290. > PROCEDURE fensterverw
  291. SELECT m&(0)
  292. CASE 20 !REDRAW
  293. wredraw(handle&,m&())
  294. CASE 21 !TOPPED
  295. wtopped(handle&)
  296. CASE 22 !CLOSED
  297. ende!=TRUE
  298. wclose!=TRUE
  299. CASE 28 !MOVED
  300. wmoved(handle&,m&())
  301. ENDSELECT
  302. RETURN
  303. > PROCEDURE wtopped(handle&)
  304. ~WIND_SET(handle&,10,0,0,0,0)
  305. RETURN
  306. > PROCEDURE wmoved(handle&,VAR m&())
  307. LOCAL wx&,wy&,d&,d&
  308. m&(4)=(m&(4) AND &HFFFFFFF8)
  309. m&(5)=(m&(5) AND &HFFFFFFF8)+1
  310. ~WIND_SET(handle&,5,m&(4),m&(5),m&(6),m&(7))
  311. ~WIND_GET(handle&,4,wx&,wy&,d&,d&)
  312. CLIP  OFFSET wx&,wy&
  313. RETURN
  314. > PROCEDURE wredraw(handle&,VAR m&())
  315. LOCAL wx&,wy&,ww&,wh&
  316. '
  317. ~WIND_UPDATE(3)
  318. ~WIND_GET(handle&,11,wx&,wy&,ww&,wh&) !erstes Fensterrechteck abfragen
  319. REPEAT
  320. IF RC_INTERSECT(m&(4),m&(5),m&(6),m&(7),wx&,wy&,ww&,wh&)
  321.   CLIP wx&,wy&,ww&,wh&
  322.   DEFFILL 0,0,0
  323.   PBOX 0,0,ww&-1,wh&-1
  324.   IF high!
  325.     high_redraw
  326.   ELSE
  327.     aufbau
  328.   ENDIF
  329. ENDIF
  330. ~WIND_GET(handle&,12,wx&,wy&,ww&,wh&) !Weitere Fensterrechtecke
  331. UNTIL wh&=0 OR ww&=0
  332. ~WIND_UPDATE(2)
  333. CLIP OFF
  334. RETURN
  335. '
  336. > PROCEDURE highscore(t%)
  337. LOCAL i|,j|
  338. IF wclose!=0
  339. high!=TRUE
  340. ~WIND_GET(handle&,4,wx&,wy&,ww&,wh&)
  341. DEFFILL 0,0,0
  342. PBOX 1,1,ww&-1,wh&-1
  343. FOR i|=1 TO 10
  344.   IF t%<t%(i|) AND j|=0
  345.     INSERT t%(i|)=t%
  346.     INSERT name$(i|)="_"
  347.     j|=i|
  348.   ENDIF
  349.   a|=5-LEN(STR$(t%(i|)))
  350.   TEXT 2,i|*16,SPACE$(a|)+STR$(t%(i|)/10)
  351.   TEXT 2+7*8,i|*16,name$(i|)
  352. NEXT i|
  353. '
  354. IF j|>0
  355.   REPEAT
  356.     TEXT 2+7*8,j|*16,name$(j|)+" "
  357.     key&=@taste
  358.     '
  359.     LET name$(j|)=@left$(name$(j|))
  360.     key&=key& MOD 256
  361.     IF key&=8 AND LEN(name$(j|))
  362.       LET name$(j|)=@left$(name$(j|))
  363.     ELSE IF LEN(name$(j|))<10 AND key&>31
  364.       LET name$(j|)=name$(j|)+CHR$(key&)
  365.     ENDIF
  366.     LET name$(j|)=name$(j|)+"_"
  367.   UNTIL key&=13 OR wclose!
  368.   LET name$(j|)=@left$(name$(j|))
  369.   TEXT 2+7*8,j|*16,name$(j|)+" "
  370. ENDIF
  371. taste!=TRUE
  372. ~@taste
  373. taste!=FALSE
  374. high!=FALSE
  375. ENDIF
  376. RETURN
  377. > FUNCTION taste
  378. LOCAL d&,key&,evnt&
  379. WHILE evnt&<>1 AND wclose!=FALSE
  380. evnt&=EVNT_MULTI(&X10001,0,0,0,0,0,0,0,0,0,0,0,0,0,adr%,10,d&,d&,d&,d&,key&,d&)
  381. IF evnt&=&X10000
  382. adr%=V:m&(0)
  383. fensterverw
  384. ENDIF
  385. WEND
  386. '  UNTIL evnt&=1 OR wclose!
  387. RETURN (key& MOD 256)
  388. ENDFUNC
  389. DEFFN left$(a$)=LEFT$(a$,LEN(a$)-1)
  390. > PROCEDURE high_redraw
  391. LOCAL i|,a|
  392. FOR i|=1 TO 10
  393. a|=5-LEN(STR$(t%(i|)))
  394. TEXT 2,i|*16,SPACE$(a|)+STR$(t%(i|)/10)
  395. TEXT 2+7*8,i|*16,name$(i|)+" "
  396. NEXT i|
  397. IF taste!
  398. TEXT 2+x_len|*16-10*8,y_len|*16+32-3,"- Taste -"
  399. ENDIF
  400. RETURN
  401.